Kaleidoscope Report
The Cognitive Disorders Research Laboratory (CDRL)
19 January, 2022 - 17:01:44 UTC
About
Kaleidoscope is an interactive R Shiny web application that provides a platform for an easy access to biological databases and bioinformatics tools via a user-friendly interface that could be explored by researchers to test hypotheses in silico. Query your target genes across different biological databases and tools to explore your research questions. The observations obtained from this platform could supplement existing hypotheses, spawn new ones and possibly direct future studies.
Input
LTK
BrainRNA-Seq
RNA-seq of cells isolated and purified from mouse and human brain from grey matter of cortex tissue. Purified using cell-type specific antibodies (anti-CD45 to capture microglia/macrophages, anti-GalC hybridoma supernatant to harvest oligodendrocytes, anti-O4 hybridoma to harvest OPCs, anti-Thy1 (CD90) to harvest neurons, anti-HepaCAM to harvest astrocytes, and BSL-1 to harvest endothelial cells).
Resources
Human
bs_res <- ks_brainseq(genes = genes, db = my_db)
bs_res_human <- filter(bs_res, Species == "Human")
bs_res_mice <- filter(bs_res, Species == "Mice")
bs_multi_genes_flag <- F
bs_multi_genes_flag <- any(c(length(unique(bs_res_human$HGNC_Symbol)), length(unique(bs_res_mice$HGNC_Symbol))) > 1)
if(nrow(bs_res) > 0) {
bs_res_human %>%
group_by(HGNC_Symbol) %>%
e_charts(CellType, timeline = ifelse(bs_multi_genes_flag, T, F), renderer="svg") %>%
e_bar(FPKM, legend = F) %>%
e_flip_coords() %>%
e_grid(
left = 200, # pixels
top = "15%" # percentage = responsive
) %>%
e_x_axis(name = "log10(FPKM + 1)",
axisLine = list(onZero = F),
nameLocation = "end"
#nameGap = 40
) %>%
e_title("Brain RNA-Seq in Human", subtext = "Gene Expression values (log10(FPKM + 1)) Per Cell Type") %>%
e_tooltip() %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView"))
}if(bs_multi_genes_flag) {
bs_res_human %>%
group_by(CellType) %>%
e_charts(renderer="svg") %>%
e_boxplot(FPKM, itemStyle = list(color = "#b8c5f2"), layout = "horizontal") %>%
e_x_axis(type = "category", axisLabel =list(rotate = 45, fontSize = 8) ) %>%
e_y_axis(name = "log10(FPKM + 1)",
axisLine = list(onZero = F),
nameLocation = "middle",
nameGap = 40
) %>%
e_title("Brain RNA-Seq in Human",
subtext = "Gene Expression values ( log10(FPKM + 1)) Per Cell Type of Input Genes") %>%
e_tooltip() %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView"))
}
if(nrow(bs_res) > 0) {
bs_res_human %>%
group_by(CellType) %>%
summarise(FPKM = mean(FPKM)) %>%
mutate(total = sum(FPKM), prob = (FPKM/total)*100,
Avg = "Input") %>%
rbind(all_human_prop) %>% select(CellType, Avg, prob) %>%
mutate_if(is.numeric, round, 2) %>%
pivot_wider(names_from = Avg, values_from = prob) %>%
e_charts(CellType, renderer="svg") %>%
e_radar(Avg, max = 50) %>%
e_radar(Input, max = 50) %>%
e_title("Brain RNA-Seq in Human", subtext = "Proportion of Gene Expression values Per Cell Type") %>%
e_tooltip() %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView")) %>%
e_legend(left = "left", top = "middle", orient = "vertical")
}Mouse
if(nrow(bs_res) > 0) {
bs_res_mice %>%
group_by(HGNC_Symbol) %>%
e_charts(CellType, timeline = ifelse(bs_multi_genes_flag, T, F), renderer="svg") %>%
e_bar(FPKM, legend = F) %>%
e_flip_coords() %>%
e_grid(
left = 200, # pixels
top = "15%" # percentage = responsive
) %>%
e_x_axis(name = "log10(FPKM + 1)",
axisLine = list(onZero = F),
nameLocation = "end"
#nameGap = 40
) %>%
e_title("Brain RNA-Seq in Mice", subtext = "Gene Expression values (log10(FPKM + 1)) Per Cell Type") %>%
e_tooltip() %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView"))
}if(bs_multi_genes_flag) {
bs_res_mice %>%
group_by(CellType) %>%
e_charts(renderer="svg") %>%
e_boxplot(FPKM, itemStyle = list(color = "#b8c5f2")) %>%
e_x_axis(type = "category", axisLabel =list(rotate = 45, fontSize = 6) ) %>%
e_y_axis(name = "log10(FPKM + 1)",
axisLine = list(onZero = F),
nameLocation = "middle",
nameGap = 40
) %>%
e_title("Brain RNA-Seq in Mice",
subtext = "Gene Expression values ( log10(FPKM + 1)) Per Cell Type of Input Genes") %>%
e_tooltip() %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView"))
}
if(nrow(bs_res) > 0) {
bs_res_mice %>%
group_by(CellType) %>%
summarise(FPKM = sum(FPKM)) %>%
mutate(total = sum(FPKM), prob = (FPKM/total)*100,
Avg = "Input") %>%
rbind(all_mice_prop) %>% select(CellType, Avg, prob) %>%
mutate_if(is.numeric, round, 2) %>%
pivot_wider(names_from = Avg, values_from = prob) %>%
e_charts(CellType, renderer="svg") %>%
e_radar(Avg, max = 50) %>%
e_radar(Input, max = 50) %>%
e_title("Brain RNA-Seq in Mice", subtext = "Proportion of Gene Expression values Per Cell Type") %>%
e_tooltip() %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView")) %>%
e_legend(left = "left", top = "middle", orient = "vertical")
}iLINCS
The integrative web platform for analysis of LINCS data and LINCS L1000 signatures. Uses the L1000 assay which is a gene-expression profiling assay based on the direct measurement of a reduced representation of the transcriptome and computational inference of the portion of the transcriptome not explicitly measured under different perturbations (like genes knockdown, drugs treatments, gene overexpression .. etc).
Resources
KD and OE Signatures
lnc_res <- ks_ilincs(genes = genes, knockdown = T, overexpression = T)
if(!is.null(lnc_res)) {
lnc_res %>%
count(Gene, Type) %>%
group_by(Type) %>%
arrange(Type,n) %>%
e_charts(Gene, reorder = F, renderer="svg") %>%
e_bar(n, position = "right") %>%
e_flip_coords() %>%
e_title("iLINCS Signatures", subtext = "Number of gene knockdown or over expression signatures") %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView")) %>%
e_tooltip()
}h2("Cell Type")Cell Type
if(!is.null(lnc_res)) {
lnc_res %>%
group_by(Type) %>%
mutate(
Tissue = ifelse(is.na(Tissue), "NA", Tissue),
Tissue = forcats::fct_lump(Tissue, 5)) %>%
count(Tissue) %>%
e_charts(Tissue, timeline = TRUE, renderer="svg") %>%
e_pie(n, roseType = "radius") %>%
e_labels() %>%
e_title("iLINCS Signatures",
subtext = "Number of signatures per tissue type (derived from cell line) - Showing only top 5, and the rest grouped under 'Other") %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView")) %>%
e_tooltip()
}Table
STRING
Database of known and predicted protein-protein interactions. The interactions include direct (physical) and indirect (functional) associations; they stem from computational prediction, from knowledge transfer between organisms, and from interactions aggregated from other (primary) databases.
Resources
if(length(genes)>1) {
string_output <- ks_string(genes,score = 500, nodes = 20, multi = T, get_img = F)
} else {
string_output <- ks_string(genes,score = 500, nodes = 20, get_img = F)
}
if(!is.null(string_output)) {
div(id = "stringEmbedded")
if(length(genes) == 1) {
str_params <- list(
species = "9606",
identifiers = c(genes),
network_flavor = "evidence",
caller_identity = 'https://cdrl-ut.org/',
add_white_nodes = 20,
required_score = 500,
single_par = T
)
htmltools::tags$script(paste0("var str_params_js = ", jsonlite::toJSON(str_params), ";"))
}
else {
str_params <- list(
species = "9606",
identifiers = string_output$genes,
network_flavor = "evidence",
caller_identity = 'https://cdrl-ut.org/',
single_par = F
)
htmltools::tags$script(paste0("var str_params_js = ", jsonlite::toJSON(str_params), ";"))
}
}GWAS Catalog
A curated collection of all published genome-wide association studies that currently contains 3841 publications and 126603 genetic variant - phenotype associations
Resources
res <- ks_gwas(genes, my_db)
if(!is.null(res)) {
reactable(select(res, -Sample_Size),
searchable = TRUE,
striped = TRUE,
bordered = TRUE,
columns = list(
Link = colDef(
cell = function(value) {
htmltools::tags$a(href = paste0("https://", value), target = "_blank", "Link")
},
style = list(color = "blue")
)
),
details = function(index) {
paste(res$Sample_Size[[index]])
}
)
}download_this(select(res, -Sample_Size),
output_name = "GWAS",
output_extension = ".xlsx",
button_label = "Download Table",
button_type = "default",
has_icon = TRUE,
icon = "fa fa-save"
)#res <- ks_gwas(genes, my_db)
if(!is.null(res)) {
res %>%
count(Trait, sort = T) %>%
head(10) %>%
arrange(n) -> res_procssed
top_traits <- pull(res_procssed, Trait) %>% unique()
}
if(!is.null(res)) {
res %>%
filter(Trait %in% top_traits) %>%
select(Gene, Type) %>%
group_by(Gene, Type) %>%
add_tally() %>% ungroup() %>%
rename(Target = Type, Source = Gene ) -> gw_test1
}
if(!is.null(res)) {
res %>%
filter(Trait %in% top_traits) %>%
select(Type, Trait) %>%
group_by(Type, Trait) %>%
add_tally() %>% ungroup() %>%
rename(Target = Trait,
Source = Type) -> gw_test2
}
if(!is.null(res)) {
res %>%
filter(Trait %in% top_traits) %>%
select(Gene, Trait) %>%
group_by(Gene, Trait) %>%
add_tally() %>% ungroup() %>%
rename(Target = Trait, Source = Gene ) -> gw_test3
}
if(!is.null(res)) {
res_procssed %>%
e_charts(Trait, renderer="svg") %>%
e_bar(n, legend = F) %>%
e_title("Number of Associated SNPs", subtext = "Only showing top 10 associated traits") %>%
e_flip_coords() %>%
e_grid(
left = 200, # pixels
top = "15%" # percentage = responsive
) %>%
e_y_axis(axisLabel = list(fontSize = 9)) %>%
e_mark_point("n", data = list(name = "Max",type = "max"), itemStyle = list(color = "red")) %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView")) %>%
e_tooltip()
}if(!is.null(res)) {
res %>%
filter(Trait %in% top_traits) %>%
mutate(
Type = ifelse(is.na(Type), "NA", Type),
Type = forcats::fct_lump(Type, 5)
) %>%
count(Type) %>%
e_charts(Type,renderer="svg") %>%
e_pie(n, roseType = "radius") %>%
e_labels() %>%
e_title("SNPs Types", subtext = "Only showing top 10 associated traits") %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView")) %>%
e_tooltip()
}if(!is.null(res)) {
rbind(gw_test1, gw_test2) %>%
e_charts(renderer="svg") %>%
e_sankey(Source, Target, n) %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView")) %>%
e_tooltip()
} if(!is.null(res)) {
gw_test3 %>%
e_charts(renderer="svg") %>%
e_sankey(Source, Target, n) %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView")) %>%
e_tooltip()
}BrainCloud
Transcription levels in the human prefrontal cortex across the lifespan. Post-mortem brains from fetal development through ageing to highlight the role of the human genome in cortical development, function and ageing. (n = 269 subjects without neuropathological or neuropsychiatric diagnosis). Age ranges: fetal, 14–20 gestational weeks, infant: 0–6 months, child, 1–10 years; adolescent and adults till ~80 years.
Resources
bs_res <- ks_braincloud(genes = head(genes, 5), db = my_db)
if(!is.null(bs_res)) {
bs_res <- group_by(bs_res, GeneSymbol)
plot_bc(bs_res, c("Fetal", "Infant", "Child", "Adult"),
"Human Lifespan", "", T,
min = -0.5, max = 80, splitNumber = 20) %>%
e_datazoom() %>%
e_tooltip() %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView"))
}
if(!is.null(bs_res)) {
plot_bc(bs_res, "Fetal", "Fetal", "", T, min = -0.5, max = -0.375) %>%
e_tooltip() %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView"))
}
if(!is.null(bs_res)) {
plot_bc(bs_res, "Infant", "Infant", "", T, min = 0, max = 0.55) %>%
e_tooltip() %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView"))
}
if(!is.null(bs_res)) {
plot_bc(bs_res, "Child", "Child", "", T, min = 1, max = 18) %>%
e_tooltip() %>% e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView"))
}
if(!is.null(bs_res)) {
plot_bc(bs_res, "Adult", "Adult", "", T, min = 18, max = 80) %>%
e_tooltip() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView"))
}BrainAtlas
Gene expression of nuclei derived from frozen human brain specimens to survey cell type diversity. Anatomical specificity is achieved by microdissecting tissue from defined brain areas. Currently this the tab contains: RNA-Seq data created from intact nuclei derived from frozen human brain specimens, to survey cell type diversity in the human middle temporal gyrus (MTG). In total, 15,928 nuclei from 8 human tissue donors ranging in age from 24-66 years were analyzed. Analysis of these transcriptional profiles reveals approximately 75 transcriptionally distinct cell types, subdivided into 45 inhibitory neuron types, 24 excitatory neuron types, and 6 non-neuronal types.
Resources
ba_res <- ks_brainatlas(genes = genes, db = my_db)
if(!is.null(ba_res)) {
ba_res %>%
{if(T) mutate(.,CPM_mean = log_transfomed(CPM_mean)) else .} %>%
group_by(CellType) %>%
e_charts(renderer="svg") %>%
e_boxplot(CPM_mean) %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView")) %>%
e_tooltip() %>%
e_show_loading(color = "black")
}if(!is.null(ba_res)) {
ba_res %>%
{if(T) mutate(.,CPM_mean = log_transfomed(CPM_mean)) else .} %>%
group_by(gene) %>%
e_charts(x = CellType,renderer="svg", timeline = T) %>%
e_bar(CPM_mean, legend = F) %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView")) %>%
e_tooltip() %>%
e_show_loading(color = "black")
}if(!is.null(ba_res)) {
ba_res %>%
{if(T) mutate(.,CPM_mean = log_transfomed(CPM_mean)) else .} %>%
{if(length(genes) == 1) {
arrange(.,desc(CPM_mean)) %>%
group_by(CellType) %>%
e_chart(.,cluster,renderer="svg", reorder = F) %>%
e_bar(e = .,CPM_mean, stack = "grp", legend = T) %>%
e_legend(selectedMode = F)
} else {
group_by(.,cluster) %>%
arrange(.,cluster, desc(CPM_mean)) %>%
e_chart(.,renderer="svg", reorder = F) %>%
e_boxplot(e = .,CPM_mean, outlier = F)
} } %>%
e_x_axis(type = 'category',
axisLabel = list(interval=0, rotate = 45, fontSize = 6)) %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView")) %>%
e_tooltip() %>%
e_show_loading(color = "black")
}if(!is.null(ba_res)) {
ba_res %>% select(-CellType) %>%
{if(T) mutate(.,CPM_mean = log_transfomed(CPM_mean)) else .} %>%
pivot_wider(names_from = cluster, values_from = CPM_mean) %>%
column_to_rownames("gene") -> mm
mm <- mm[apply(mm, 1, var) != 0, ]
heatmaply::heatmaply(
mm, scale = ifelse(T, "row", "none"),
fontsize_col = 5,
fontsize_row = 5,
Rowv = ifelse(length(ba_res$gene %>% unique()) > 1, T, F )
) %>%
plotly::config(
toImageButtonOptions = list(
format = "svg",
filename = "ba_hm"
)
)
}if(!is.null(ba_res)) {
ba_res %>%
group_by(CellType) %>%
summarise(FPKM = mean(CPM_mean)) %>%
mutate(total = sum(FPKM), mean_prob = (FPKM/total)*100,
Avg = "Input") %>%
select(CellType, mean_prob, Avg) %>%
rbind(ba_all_human_avg) %>% select(CellType, Avg, mean_prob) %>%
mutate_if(is.numeric, round, 2) %>%
pivot_wider(names_from = Avg, values_from = mean_prob) %>%
e_charts(CellType, renderer="svg") %>%
e_radar(Avg, max = 50) %>%
e_radar(Input, max = 50) %>%
e_title("BrainAtlas", subtext = "Proportion of Gene Expression values Per Cell Type") %>%
e_tooltip() %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView")) %>%
e_legend(bottom = 0) %>%
e_show_loading(color = "black")
}GTEx
Database contains data of tissue-specific gene expression and regulation. Samples were collected from 53 tissues from almost 1000 individuals, primarily for molecular assays including WGS, WES, and RNA-Seq. Has eQTL, expression quantitative trait loci, data for all studied tissues to identify variant-gene expression association
Resources
gtex_res <- ks_gtex(genes = genes, db = my_db)
if(!is.null(gtex_res)) {
gtex_res %>%
pivot_longer(2:ncol(.), names_to = "Tissue", values_to = "TPM") -> gtex_res_processed
gtex_res_processed %>%
#{if(input$switch3) filter(.,Tissue %in% brain_tissues) else . } %>%
{if(T) mutate(.,TPM = log_transfomed(TPM)) else .} %>%
{if(length(genes) == 1) {
arrange(.,desc(TPM)) %>%
#group_by(Group) %>%
e_chart(.,Tissue,renderer="svg", reorder = F) %>%
e_bar(e = .,TPM, stack = "grp", legend = F)
} else {
group_by(.,Tissue) %>%
arrange(.,Tissue, desc(TPM)) %>%
e_chart(.,renderer="svg", reorder = F) %>%
e_boxplot(e = .,TPM, outlier = F)} } %>%
e_x_axis(type = 'category',
axisLabel = list(interval=0, rotate = 45, fontSize = 6)) %>%
e_title("GTEx Gene Expression",
subtext = ifelse(T,
"Median Gene Expression, log10(TPM + 1), Across Different Tissues in Healthy Human",
"Median Gene Expression (TPM) Across Different Tissues in Healthy Human")) %>%
e_toolbox() %>%
e_toolbox_feature(feature = c("saveAsImage", "dataView")) %>%
e_tooltip() %>%
e_show_loading(color = "black")
}if(!is.null(gtex_res)) {
gtex_res %>%
column_to_rownames("gene") %>%
{if(T) mutate_if(.,is.numeric, log_transfomed) else .} -> mm
#{if(input$switch3) select(., one_of(brain_tissues)) else .} -> mm
mm <- mm[apply(mm, 1, var) != 0, ]
heatmaply::heatmaply(
mm, scale = ifelse(T, "row", "none"),
fontsize_col = 5,
fontsize_row = 5,
Rowv = ifelse(length(gtex_res$gene) > 1, T, F )
) %>%
plotly::config(
toImageButtonOptions = list(
format = "svg",
filename = "gtex_hm"
)
)
}